home *** CD-ROM | disk | FTP | other *** search
Text File | 1996-05-26 | 5.6 KB | 202 lines | [TEXT/ROSA] |
- ;;;
- ;;; PowerLisp 2.0
- ;;; Copyright © 1996 Roger Corman. All rights reserved.
- ;;;
- ;;;
- ;;; Common Lisp 'documentation' function.
- ;;;
- (in-package :common-lisp)
- (provide :documentation)
-
- ;;;;
- ;;;; documentation.lisp
- ;;;;
- ;;;; This file contains code relating to the online help
- ;;;; facility in PowerLisp, and the CLTL2 browser.
- ;;;;
-
- (defvar cltl2-chapters
- '(
- "Chapter 01. Introduction"
- "Chapter 02. Data Types"
- "Chapter 03. Scope and Extent"
- "Chapter 04. Type Specifiers"
- "Chapter 05. Program Structure"
- "Chapter 06. Predicates"
- "Chapter 07. Control Structure"
- "Chapter 08. Macros"
- "Chapter 09. Declarations"
- "Chapter 10. Symbols"
- "Chapter 11. Packages"
- "Chapter 12. Numbers"
- "Chapter 13. Characters"
- "Chapter 14. Sequences"
- "Chapter 15. Lists"
- "Chapter 16. Hash Tables"
- "Chapter 17. Arrays"
- "Chapter 18. Strings"
- "Chapter 19. Structures"
- "Chapter 20. The Evaluator"
- "Chapter 21. Streams"
- "Chapter 22. Input & Output"
- "Chapter 23. File System Interf…"
- "Chapter 24. Errors"
- "Chapter 25. Misc. Features"
- "Chapter 26. Loop"
- "Chapter 27. Pretty Printing"
- "Chapter 28. CLOS"
- "Chapter 29. Conditions"
- "PowerLisp Doc"
- ))
-
- (defvar cltl2-directory ":Documentation:")
- (defvar cltl2-index-name "cltl2-index.lisp")
-
- (defun process-doc-files (&key (start 1) (end (length cltl2-chapters)))
- (do* ((chap (nthcdr (1- start) cltl2-chapters) (cdr chap))
- (index start (1+ index)))
- ((or (null chap) (> index end)))
- (let ((filename (concatenate 'string cltl2-directory (car chap))))
- (compile-doc-file index))))
-
- (defun compile-doc-file (index)
- (let* ((menu (nth (1- index) cltl2-chapters))
- (filename (concatenate 'string cltl2-directory menu)))
- (pl:ed filename)
- (pl:set-selection filename 0 0 0 0)
- (do (string (found t) pos result)
- ((not found))
- (setq found (pl:select-next-bold-string filename))
- (if found
- (progn
- (setq string (string-trim '(#\Newline #\Space) (pl:get-selection-string filename)))
- (setq pos (pl:get-selection-position filename))
- (setq result (multiple-value-list (find-symbol (string-upcase string) :common-lisp)))
- (if (eq (cadr result) :external)
- ;; if the string represents a common lisp external symbol
- (format t "(asd '~A ~S ~{~S ~})~%" string index pos)
- ;; else just set up a menu selection tag
- (format t "(adr ~S ~S ~{~S ~})~%" string index pos)))))
- (pl:close-edit-window filename)))
-
- (defun asd (symbol index &rest selection)
- (let* ((menu (nth (1- index) cltl2-chapters))
- (filename (concatenate 'string cltl2-directory menu)))
- (push (list 'common-lisp filename selection) (get symbol 'documentation))
- (pl:add-menu-item `(:command ,(symbol-name symbol) (documentation ',symbol 'common-lisp)) menu 500)))
-
- (defun adr (string index &rest selection)
- (let* ((menu (nth (1- index) cltl2-chapters))
- (filename (concatenate 'string cltl2-directory menu)))
- (pl:add-menu-item
- `(:command ,string
- (progn (pl:ed ,filename)
- (pl:set-selection ,filename
- ,(first selection)
- ,(second selection)
- ,(third selection)
- ,(fourth selection))))
- menu 500)))
-
- (defun documentation (symbol &optional (type 'function))
- (let ((doclist (get symbol 'documentation))
- doc-clause)
-
- ;; if the requested symbol is in the common-lisp package, and
- ;; has documentation of type common-lisp as the first type, then
- ;; use a special algorithm to display the information from CLTL2 text
- (if (and (eq (caar doclist) 'common-lisp)
- (eq (symbol-package symbol) (find-package 'common-lisp)))
- (setq type 'common-lisp))
- (setq doc-clause (assoc type doclist))
- (unless doc-clause
- (return (format nil "No documentation available for ~A ~A" type symbol)))
- (if (and (eq (first doc-clause) 'common-lisp)
- (probe-file (second doc-clause)))
- (let ((filename (second doc-clause))
- (selection (third doc-clause)))
- (pl:ed filename)
- (pl:set-selection filename
- (first selection)
- (second selection)
- (third selection)
- (fourth selection))
- "Common Lisp, the Language, 2nd edition, courtesy of Digital Press and Guy Steele")
- ;; else just return the doc string
- (cdr doc-clause))))
-
- ;;
- ;; load the index file if it exists, and create the menu structure
- (let ((index-file (concatenate 'string cltl2-directory cltl2-index-name)))
- (pl:add-menu-item '(:menu "Documentation") nil 0)
- (pl:add-menu-item '(:menu "PowerLisp Doc") "Documentation" 0)
- (if (probe-file index-file)
- (progn
- (pl:add-menu-item '(:command "---" nil) "Documentation" 100)
- (pl:add-menu-item '(:command "Common Lisp the Language" nil) "Documentation" 100)
- (pl:add-menu-item '(:command "---" nil) "Documentation" 100)
- (dolist (chap (butlast cltl2-chapters))
- (pl:add-menu-item (list :menu chap) "Documentation" 100))
- (load index-file))))
-
-
- ;;(adr "PowerLisp" 30 1 6 1 15 )
- (adr "Contents" 30 19 6 20 0 )
- (adr "Introduction" 30 82 0 84 0 )
- (adr "Licensing" 30 158 0 160 0 )
- (adr "Quick Start Tutorial" 30 267 0 269 0 )
- (adr "Files in this Release" 30 466 0 468 0 )
- (adr "Interactive Environment" 30 545 0 547 0 )
- (adr "Preferences" 30 629 0 630 0 )
- (adr "PowerEdit Text Editor" 30 656 0 658 0 )
- (adr "PowerLisp Compiler" 30 819 0 819 18 )
- (adr "68k Compiler" 30 822 0 822 12 )
- (adr "PowerPC Compiler" 30 871 0 872 0 )
- (adr "PowerLisp Assembler" 30 898 0 900 0 )
- (adr "PowerLisp Disassembler" 30 934 0 936 0 )
- (adr "Linking and Debugging" 30 956 0 958 0 )
- (adr "Memory Usage" 30 1012 0 1014 0 )
- (adr "Operating System Issues" 30 1064 0 1066 0 )
- (adr "Common Lisp Implementation" 30 1084 0 1086 0 )
- (adr "CLOS" 30 1444 0 1445 0 )
- (adr "Non-standard Extensions" 30 1534 0 1536 0 )
- (adr "New Features" 30 1635 0 1636 0 )
- (adr "Troubleshooting" 30 1708 0 1710 0 )
- (adr "Notes" 30 1801 0 1802 0 )
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-